Option Compare Database
Private Sub Command65_Click()
   If MsgBox("Confirm?", vbYesNo, "Confirm") = vbYes Then
        SaveAttachments "C:\Users\owl\Documents\pic\foldname", "tablename", "fieldname", "key_fieldname"
    Else
    End If
End Sub
Public Function SaveAttachments(strPath As String, strTable As String, strField As String, strKeyField As String, Optional strPattern As String = "*.*") As Long
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim fld As DAO.Field2
    Dim strFullPath As String
    Dim strID As String
    Dim c As Integer, i As Integer, j As Integer
    'Get the database, recordset, and attachment field
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strTable)
    Set fld = rst(strField)
    'Navigate through the table
    Do While Not rst.EOF
        'Get the recordset for the Attachments field
        Set rsA = fld.Value
        'Save all attachments in the field
        Do While Not rsA.EOF
            If rsA("FileName") Like strPattern Then
strFullPath = strPath & "\" & rst(strKeyField).Value & "." & LCase(rsA("FileName"))
                'Make sure the file does not exist and save
                If Dir(strFullPath) = "" Then
                    rsA("FileData").SaveToFile strFullPath
                End If
                'Increment the number of files saved
                SaveAttachments = SaveAttachments + 1
            End If
            'Next attachment
            rsA.MoveNext
        Loop
        rsA.Close
        'Next record
        rst.MoveNext
    Loop
    rst.Close
    dbs.Close
    Set fld = Nothing
    Set rsA = Nothing
    Set rst = Nothing
    Set dbs = Nothing
End Function
